home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].zip / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].adf / Acechan / Acechan.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-23  |  7KB  |  249 lines
  1. (*****************************************************************************
  2.  *
  3.  * Acechan -- Produces data files which contain random data spread info.
  4.  * (c)1995 Lee "Wangi" Kindness
  5.  *
  6.  *)
  7.  
  8. Program Acechan;
  9.  
  10. Uses
  11.     Exec, AmigaDos, Amiga, Graphics;
  12.  
  13. Const
  14.     { Version string }
  15.     VERSTAG : String[29] = '$VER: Acechan 1.3 (12.06.95)'#0;
  16.  
  17. Type
  18.     tConfig = Record
  19.         cf_Outfile    : String; { name of file to output to          }
  20.         cf_Min,                 { minimum value of range             }
  21.         cf_Max,                 { maximum value in range             }
  22.         cf_Iterations,          { number of iterations               }
  23.         cf_dp,                  { number of decimal places in output }
  24.         cf_HashPer    : LONG;   { Hash for every n items             }
  25.         cf_NoSysHog,            { Hog the system?                    }
  26.         cf_RawOnly    : Boolean;{ do the graphical representation?   }
  27.     End;
  28.  
  29. (*****************************************************************************)
  30. Function GetInput(VAR cfg : tConfig) : Boolean;
  31. { Get options from the command line, using Amiga functions }
  32.  
  33. Const
  34.     TEMP : String[90] = 'MINIMUM/N,MAXIMUM/N,ITERATIONS/N,DP/K/N,RAWONLY/S,SCALE=HASHPER/K/N,NOSYSHOG/S,OUTPUTFILE'#0;
  35.     OPT_MIN   = 0; { minimum value of range             }
  36.     OPT_MAX   = 1; { maximum value in range             }
  37.     OPT_ITER  = 2; { number of iterations               }
  38.     OPT_DP    = 3; { number of decimal places in output }
  39.     OPT_RAW   = 4; { do the graphical representation?   }
  40.     OPT_HAPER = 5; { hash per n items                   }
  41.     OPT_NSYSH = 6;
  42.     OPT_FILE  = 7; { name of file to output to          }
  43.     rda : Array[OPT_MIN..OPT_FILE] Of Pointer = (NIL);
  44.  
  45. Var
  46.     RDArgs : pRDArgs;
  47.  
  48. Begin
  49.     GetInput := False;
  50.     { init cfg to defaults }
  51.     With cfg do Begin
  52.         cf_Min        := 1;
  53.         cf_Max        := 100;
  54.         cf_Iterations := 1000;
  55.         cf_dp         := 4;
  56.         cf_Outfile    := 'acechan.results';
  57.         cf_RawOnly    := False;
  58.         cf_NoSysHog   := False;
  59.         cf_HashPer    := 1;
  60.     End;
  61.     RDArgs := ReadArgs(@TEMP[1], @rda, NIL);
  62.     If RDArgs <> NIL Then Begin
  63.         If rda[OPT_MIN] <> NIL Then
  64.             cfg.cf_Min := pLONG(rda[OPT_MIN])^;
  65.         If rda[OPT_MAX] <> NIL Then
  66.             cfg.cf_Max := pLONG(rda[OPT_MAX])^;
  67.         If rda[OPT_ITER] <> NIL Then
  68.             cfg.cf_Iterations := pLONG(rda[OPT_ITER])^;
  69.         If cfg.cf_Iterations < 10 Then
  70.             cfg.cf_Iterations := 10;
  71.         If rda[OPT_DP] <> NIL Then
  72.             cfg.cf_dp := pLONG(rda[OPT_DP])^;
  73.         If rda[OPT_RAW] <> NIL Then
  74.             cfg.cf_RawOnly := True;
  75.         If rda[OPT_HAPER] <> NIL Then
  76.             cfg.cf_HashPer := pLONG(rda[OPT_HAPER])^;
  77.         If rda[OPT_NSYSH] <> NIL Then
  78.             cfg.cf_NoSysHog := True;
  79.         If rda[OPT_FILE] <> NIL then
  80.             cfg.cf_Outfile := PtrToPas(rda[OPT_FILE]);
  81.         FreeArgs(RDArgs);
  82.         GetInput := True;
  83.     End;
  84. End;
  85.  
  86. (*****************************************************************************)
  87. Procedure DoIt(VAR cfg : tConfig);
  88.  
  89. (*****************)
  90. (*
  91.  * Set of functions to handle the 'array' type memory heap
  92.  * quite a lot of dodgy programming here :)... Well not really, it is equiv.
  93.  * to an array allocation in C...
  94.  * If you are not an Amiga programmer then this might help:
  95.  *  LONG = LongInt;
  96.  *  pLONG = ^LONG;
  97.  *  AllocVec allocates memory from the system, MENF_CLEAR specifying that
  98.  *  it should be initilised to zeros, FreeVec will free this memory. I used
  99.  *  Amiga kernal functions rather than portable pascal ones because the pascal
  100.  *  ones use heap space...:(
  101.  *)
  102.  
  103. Function AllocBuf : pLONG;
  104. Begin
  105.     AllocBuf := AllocVec((Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)), MEMF_CLEAR);
  106.     (*
  107.      * Using standard pascal functions:
  108.      *
  109.      * VAR
  110.      *   p, e : pLONG;
  111.      *   n    : LONG;
  112.      *
  113.      * GetMem(p, (Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)));
  114.      * If p <> NIL Then Begin
  115.      *   FillChar(p^, (Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)), 0);
  116.      * End;
  117.      * AllocBuf := p;
  118.      *)
  119. End;
  120.  
  121. Procedure FreeBuf(buf : pLONG);
  122. Begin
  123.     FreeVec(buf);
  124.     (*
  125.      * Using standard pascal functions:
  126.      *
  127.      * FreeMem(buf, (Sizeof(LONG) * (cfg.cf_Max - cfg.cf_Min + 1)));
  128.      *)
  129. End;
  130.  
  131. Procedure IncBuf(buf : pLONG; entry : LONG);
  132. Var
  133.     e : pLONG;
  134. Begin
  135.     e := pLONG(LONG(buf) + ((entry - cfg.cf_Min) * Sizeof(LONG)));
  136.     inc(e^);
  137. End;
  138.  
  139. Function AccessBuf(buf : pLONG; entry : LONG) : LONG;
  140. Var
  141.     e : pLONG;
  142. Begin
  143.     e := pLONG(LONG(buf) + ((entry - cfg.cf_Min) * Sizeof(LONG)));
  144.     AccessBuf := e^;
  145. End;
  146.  
  147. Function RandRange(min, max : LONG) : LONG;
  148. Begin
  149.     RandRange := Random(max - min + 1) + min;
  150. End;
  151.     
  152. (*****************)
  153.  
  154. Var
  155.     buf : pLONG;
  156.     n, num, y, currentnumhash : LONG;
  157.     f : Text;
  158.     
  159. Begin
  160.     Randomize;
  161.     With cfg Do Begin
  162.         buf := AllocBuf;
  163.         If buf <> NIL Then begin
  164.             { generate the random spread }
  165.             For n := 1 To cf_Iterations do Begin
  166.                 num := RandRange(cf_Min, cf_Max);
  167.                 IncBuf(buf, num);
  168.                 { wait a while... if wished }
  169.                 If cf_NoSysHog Then
  170.                     WaitTOF;
  171.             End;
  172.             { create the output file }
  173.             { Assign(f, cf_OutFile); }
  174.             {$I-} ReWrite(f, cf_Outfile); {$I+}
  175.             If IOResult = 0 Then Begin
  176.                 Writeln(f, '; Data results file created by Acechan, ©Lee Kindness');
  177.                 Writeln(f, '; ',verstag);
  178.                 Writeln(f, ';');
  179.                 Writeln(f, '; Preferences:');
  180.                 Writeln(f, '; OUTPUTFILE = "',cf_Outfile,'"');
  181.                 Writeln(f, '; MINIMUM    = ',cf_Min);
  182.                 Writeln(f, '; MAXIMUM    = ',cf_Max);
  183.                 Writeln(f, '; ITERATIONS = ',cf_Iterations);
  184.                 Writeln(f, '; DP         = ',cf_dp);
  185.                 Writeln(f, '; RAWONLY    = ',cf_RawOnly);
  186.                 Writeln(f, '; HASHPER    = ',cf_HashPer);
  187.                 Writeln(f, '; NOSYSHOG   = ',cf_NoSYSHog);
  188.                 { the raw data }
  189.                 Writeln(f, ';');
  190.                 Writeln(f, '; RAW DATA:');
  191.                 Writeln(f, ';');
  192.                 For n := cf_Min to cf_Max do
  193.                     Writeln(f, n:5,' : ',AccessBuf(buf, n):5,', ',((AccessBuf(buf, n)/cf_Iterations)*100):0:cf_dp,'%');
  194.                 If NOT cf_RawOnly Then Begin
  195.                     { the distribution 'curve' }
  196.                     Writeln(f, ';');
  197.                     Writeln(f, '; DISTRIBUTED REPRESENTATION');
  198.                     Writeln(f, ';');
  199.                     
  200.                     For n := cf_Min to cf_Max do Begin
  201.                         Write(f, n:5,' ');
  202.                         num := AccessBuf(buf, n);
  203.                         currentnumHash := 0;
  204.                         for y := 1 to num Do Begin
  205.                             inc(currentnumhash);
  206.                             If currentnumhash >= cf_HashPer Then begin
  207.                                 currentnumhash := 0;
  208.                                 Write(f, '#');
  209.                             End;
  210.                         End;
  211.                         Writeln(f, '  ',num,' ',((AccessBuf(buf, n)/cf_Iterations)*100):0:cf_dp,'%');
  212.                     End;
  213.                 End;
  214.                 Writeln(f, ';');
  215.                 Writeln(f, '; END OF FILE');
  216.                 Writeln(f, ';');
  217.                 Writeln('Finished... Data file is "',cf_OutFile,'"');
  218.                 Close(f);
  219.             End;
  220.             FreeBuf(buf);
  221.         End Else
  222.             Writeln('Insuficient memory... try lowering MAXIMUM');
  223.     End;
  224. End;
  225.  
  226. (*****************************************************************************)
  227. Procedure Main;
  228.  
  229. Var
  230.     cfg : tConfig;
  231.  
  232. Begin
  233.     If pLibrary(SysBase)^.lib_Version >= 36 Then Begin
  234.         If pLibrary(DosBase)^.lib_Version >= 36 Then Begin
  235.             GfxBase := pGfxBase(OpenLibrary('graphics.library', 0));
  236.             if GfxBase <> NIL Then Begin
  237.                 If GetInput(cfg) Then Begin
  238.                     DoIt(cfg);
  239.                 End;
  240.             CloseLibrary(pLibrary(GfxBase));
  241.             End;
  242.         End Else Writeln('requires dos 36');
  243.     End Else Writeln('requires exec 36');
  244. End;
  245.  
  246. (*****************************************************************************)
  247. Begin main End.
  248.  
  249. (*****************************************************************************)